home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / risc_src.lha / risc_sources / comp / front_end / free_stuff.t < prev    next >
Encoding:
Text File  |  1989-06-30  |  1.1 KB  |  50 lines
  1. (herald free_stuff)
  2.  
  3. (define (flist1 a x)
  4.   (cons-from-freelist a x))
  5.  
  6. (define (flist2 a b x)
  7.   (cons-from-freelist a 
  8.   (cons-from-freelist b x)))
  9.  
  10. (define (flist3 a b c x) 
  11.   (cons-from-freelist a
  12.   (cons-from-freelist b
  13.   (cons-from-freelist c x))))
  14.  
  15. (define (flist4 a b c d x)
  16.   (cons-from-freelist a
  17.   (cons-from-freelist b
  18.   (cons-from-freelist c
  19.   (cons-from-freelist d x)))))
  20.  
  21. (define (flist5 a b c d e x)
  22.   (cons-from-freelist a
  23.   (cons-from-freelist b
  24.   (cons-from-freelist c
  25.   (cons-from-freelist d
  26.   (cons-from-freelist e x))))))
  27.  
  28. (define (free-copy-list l)
  29.   (do ((l l (cdr l))
  30.        (f '() (cons-from-freelist (car l) f)))
  31.       ((null? l)
  32.        (reverse! f))))
  33.  
  34. (define (free-copy-tree tree)
  35.   (iterate label ((tree tree))
  36.     (cond ((pair? tree)
  37.            (cons-from-freelist (label (car tree))
  38.                                (label (cdr tree))))
  39.           (else
  40.            tree))))
  41.  
  42. (define (return-tree-to-freelist tree)
  43.   (iterate label ((tree tree))
  44.     (cond ((pair? tree)
  45.            (label (car tree))
  46.            (label (cdr tree))
  47.            (return-to-freelist tree))))
  48.   (return))
  49.  
  50.